.TITLE	DRASG
	.IDENT	/11.14/
;
; Copyright (c) 1995-1999 by Mentec, Inc., U.S.A.
; All rights reserved
;
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;
; PREVIOUSLY MODIFIED BY:
;
;	J. R. KAUFFMAN
;	K. L. NOEL
;	J. W. BERZLE
;	ERIC POSTPISCHIL
;	PAUL K. M. WEISS
;
; MODIFIED FOR CPRSX V2.O BY:
;
;
;	Eric Postpischil	11.14		19-Sep-1989
;		edp075 -- Remove prohibition on assignments to pseudo devices.
;
;	Paul K. M. Weiss	11.13		12-JUN-1989
;		PKW177 -- Change H$TIUC to H$UNIT.
;
; MACRO LIBRARY CALLS
;

	.MCALL	TCBDF$
	TCBDF$			;DEFINE TASK CONTROL BLOCK OFFSETS
	.MCALL	UCBDF$							
	UCBDF$	,,1							

	.IF DF  C$$RTK 		;REMOTE TASK SUPPORT

	.MCALL	CPRDF$
	CPRDF$

;
; LOCAL DATA
;
IMPFLG: .WORD	0		;IF = 1 CALLED AT IMPASG
LUNNUM: .WORD	0		;LUN NUMBER FOR IMPLICIT ALUN
OLDUCB: .WORD	0		;FORMER UCB ASSIGNMENT

	.ENDC	; C$$RTK
;
; LOCAL SYMBOLS
;
MAP6	=	140000		;ADDRESS TO MAP APR6
AS$DIC  = 	7		;DIC FOR ASSIGN LUN
AS$SIZ  =       4		;SIZE OF DPB FOR ASSIGN LUN
AC$DIC	=	207.		;DIC FOR ASSIGN CHANNEL		
AC$SIZ 	=	5		;SIZE OF DPB FOR ASSIGN CHANNEL	
AC$SUB	=	6		;SUBFUNCTION FOR ASSIGN CHANNEL	
VNAMSZ	=	8.		;SIZE OF VMS TERMINAL NAME


;+
; **-$DRASG-ASSIGN LUN
;
; THIS DIRECTIVE INSTRUCTS THE SYSTEM TO ASSIGN A DEVICE UNIT TO A
; LOGICAL UNIT NUMBER (LUN).
;
; DPB FORMAT:
;
;	WD. 00 -- DIC(7.),DPB SIZE(4.).
;	WD. 01 -- LUN TO BE ASSIGNED.
;	WD. 02 -- NAME OF DEVICE TO BE ASSIGNED.
;	WD. 03 -- UNIT NUMBER OF DEVICE TO BE ASSIGNED.
;
; INPUTS:
;
;	R2=ADDRESS OF THE TASK STATUS WORD OF THE CURRENT TASK.
;	R3=ADDRESS OF THE LUN IN THE DPB.
;	R4=ADDRESS OF THE HEADER OF THE CURRENT TASK.
;	R5=ADDRESS OF THE TCB OF THE CURRENT TASK.
;
; OUTPUTS: (DIRECTIVE STATUS AND PS RETURNED TO TASK)
;
;	C=0 IF DIRECTIVE IS SUCCESSFULLY COMPLETED.
;		DIRECTIVE STATUS OF +1 IS RETURNED.
;	C=1 IF DIRECTIVE IS REJECTED.
;		DIRECTIVE STATUS OF 'D.RS90' IS RETURNED IF A FILE
;			IS OPEN OR UNIT ATTACHED ON THE SPECIFIED LUN.
;		DIRECTIVE STATUS OF 'D.RS92' IS RETURNED IF DEVICE
;			AND/OR UNIT IS INVALID.
;-

;
; PACKET FORMAT FOR REMOTE ALUN
;
;	+---------------------------+
;	|                           |
;	|         HEADER            |
;	|                           |
;	+---------------------------+
;	|			    |
;	|	  ALUN DPB          |
;	|			    |
;	+---------------------------+
;	|  PTR TO 2ND WORD IN LUN   |
;	+---------------------------+
;	;   FORMER UCB ADDRESS      ;
;	+---------------------------+
;	|       SAVED KISAR6        |
;	+---------------------------+
;	|       SAVED IMPFLG        |
;	+---------------------------+
;
;+
; **-$IMAS1-IMPLICIT LUN ASSIGNMENT
;
; THIS ROUTINE DOES AN IMPLICIT ALUN FOR THE DIRECTIVE WHICH CALLED IT
;
; IF SYSTEM SUPPORTS REMOTE TASK SERVICES, A CALL TO CPRAME WILL BE MADE
;  TO FIND THE LUN ASSIGNMENT.  NO ATTEMPT IS MADE TO SAVE THE CONTEXT OF
;  THE ORIGINAL DIRECTIVE.  THE PC OF THE USER TASK IS BACKED UP OVER THE
;  THE TRAP SO THE DIRECTIVE WILL BE ISSUED AGAIN.
;
; INPUTS:
;
;	R1 - POINTER TO 2ND LUN WORD OF TASK HEADER
;	R3 - POINTER TO THE LUN NUMBER IN THE DPB
; 
; OUTPUTS:
;
;	THE LUT ENTRY IS FILLED IN WITH THE UCB OF THE DEVICE.  IF THE DEVICE
;       IS NOT FOUND THE DIRECTIVE STATUS OF 'D.RS92' IS RETURNED 
;	
;-

$DRASG::CALL	$MPLUN		;MAP LUN TO DEVICE UCB
	TST	(R1)		;FILE ACCESSED ON LUN?
	BEQ	10$		;IF EQ NO
	DRSTS	D.RS90		;RETURN WITH ERROR STATUS
10$:				;

	.IF DF C$$RTB		; RUN TIME BINDING

	CLR	IMPFLG		;INDICATE NOT IMPLICIT ALUN
	BR	RTK		;JOIN COMMON CODE

$IMAS1::

	MOV	#1,IMPFLG	;INDICATE THIS WAS AN IMPLICIT CALL
	CLR	R0		;NO FORMER UCB ADDRESS
	
RTK:	
	MOV	R0,OLDUCB	;SAVE FORMER UCB ASSIGNMENT
	MOV	-2(R3),R2	;GET LUN NUMBER

	.IF DF  C$$RTK		;REMOTE TASK SUPPORT

	BIT	#F5.RTK,$FMSK5	;ARE WE USING REMOTE TASK SUPPORT
	BNE	10$		;IF NE YES
	JMP	160$		;DO NON REMOTE LUN ASSIGNMENT
;
; GET A REQUEST PACKET FROM CPRBUF
;
10$:	MOV	R1,R4		;SAVE POINTER TO 2ND LUN WORD
	MOV	R2,LUNNUM	;SAVE LUN NUMBER
	MOV	R3,R5		;SAVE POINTER TO DPB
	MOV	#1,R1		;SET FOR 1 BLOCK FROM CPRBUF
	MOV	#AL$BCK!AL$IMP,R0 ;BLOCK THE TASK, DO IMPLICIT START
	CALL	$CPALO		;GET BUFFER FROM CPRBUF
	MOV	KISAR6,-(SP)	; SAVE CURRENT MAPPING.
	MOV	R0,KISAR6	; MAP PACKET.
	MOV	#IS.SUC,MAP6+H$STAT
				; MARK PACKET WITH SUCCESS SO THAT IMPLICIT
				;    ASSIGNMENTS TO OV: APPEAR SUCCESSFUL EVEN
				;    THOUGH THEY NEVER GO TO VMS.
	MOV	(SP)+,KISAR6	; RESTORE MAPPING.
;
; GET DEVICE AND UNIT NUMBER BEFORE WE UNMAP THE HEADER
;  - FOR IMPLICIT ALUN, THE DEVICE AND UNIT NUMBER IS IN THE LUT EXTENSION
;    OFFSET INTO LUT IS THE SAME AS IN THE HEADER LUT.  THE ADDRESS OF 
;    THE PROTO LUN IS GOTTEN BY SUBTRACTING H.LUN+140000 FROM THE ADDRESS OF THE
;    2ND LUN WORD THEN ADDING THE BASE ADDRESS OF THE LUT EXTENSION.
;  - FOR REGULAR REMOTE ALUN, THE DEVICE AND UNIT NUMBER ARE GOTTEN FROM
;    THE DPB
;
	TST	IMPFLG		;IMPLICIT ALUN
	BEQ	30$		;IF EQ NO

	MOV	R4,R1		;GET ADDRESS OF 2ND LUN WORD
	SUB	#H.LUN+2+MAP6,R1 ;GET OFFSET INTO LUT EXTENSION
	ADD	MAP6+H.LUTE,R1	;ADD EXTENSION OFFSET
	MOV	(R1)+,R2	;GET DEVICE NAME
	BEQ	20$		;IF EQ, UNASSIGNED LUN
	MOV	(R1),R3		;GET UNIT NUMBER
;
; SPECIAL CASE OV - IF THIS IS AN IMPLICIT CALL, DON'T LET CPRAME
;  TRY TO TRANSLATE THE LOGICAL
;
	CMP	#"OV,R2		;IS THIS OV?
	BNE	40$		;IF NE NO

	MOV	R0,$CPPKT	;SET ADDRESS OF PACKET TO DEALLOCATE
								
	MOV	$TKTCB,R5	;GET CURRENT TASK'S TCB
	MOV	T.LDV(R5),R1	;GET LOAD DEVICE UCB
	JMP	260$		;JOIN COMMON CODE

20$:	DRSTS	D.RS5		;RETURN WITH ERROR CODE IE.ULN

30$:	MOV	(R5),R2		;GET DEVICE FROM DPB
	MOV	2(R5),R3	; AND UNIT NUMBER
;
; FILL IN THE HEADER AND THE ALUN DPB
;
40$:	MOV	KISAR6,-(SP)	;SAVE MAPPING TO TASK HEADER
	MOV	R0,KISAR6	;MAP PACKET
	MOV	#MAP6,R1	;GET ADDRESS OF PACKET HEADER
	MOVB	#HT$DIR,H$TYPE(R1) ;DIRECTIVE REQUST
	CLRB	H$ICNT(R1)	;NO ITEMS
	ADD	#P$DPB,R1	;POINT TO DPB AREA
	MOVB	#AS$DIC,(R1)+	;DIC
	MOVB	#AS$SIZ,(R1)+	;SIZE
	MOV	LUNNUM,(R1)+	;COPY LUN NUMBER
	MOV	R2,(R1)+	;DEVICE NAME
	MOV	R3,(R1)+	;UNIT NUMBER
;
; FILL IN THE COMMON EXTRA STORAGE AREA
;
	ADD	#6,R1		;SKIP 6 BYTES FOR COMPATIBILITY WITH ACHN$
	MOV	R4,(R1)+	;SAVE POINTER TO 2ND LUN WORD IN TASK HEADER
	MOV	OLDUCB,(R1)+	;SAVE OLD UCB ADDRESS			
	MOV	(SP)+,(R1)+	;SAVE MAPPING TO HEADER
;
; IF THIS IS AN IMPLICIT ALUN, SET SN$IMP SO DRFIN WILL NOT BE CALLED YET
;
	MOV	#SN$DIR,R2	;SET DIRETIVE FLAG
	MOV	IMPFLG,(R1)	;IMPLICIT ALUN
	BEQ	50$		;IF EQ NOT IMPLICIT
	MOV	#SN$IMP,R2	;SET IMPLICIT FLAG
50$:	SUB	#140000,R1	;GET SIZE OF PACKET			
;
; SEND PACKET TO THE DRIVER
;
60$:
	CLR	$CPPKT		; MAKE SURE NO ONE USES PACKET WHILE WE'RE GONE
	CPSEN$	R2,KISAR6,R1	; SEND REQUEST TO HOST AME
;									
; MAP PACKET AND RETRIEVE IMPFLG AND POINTER INTO THE HEADER
;
	MOV	R0,KISAR6	;MAP PACKET
	MOV	#MAP6,R5	;GET ADDRESS OF HEADER			
	ADD	#P$DPB,R5	;POINT TO DPB				
	MOV	R0,$CPPKT	;SAVE ADDRESS OF PACKET			
	MOV	2(R5),$CPLUN	;SAVE LUN NUMBER			
	CMPB	#AC$DIC,(R5)	;IS THIS ACHN$?				
	BNE	70$		;IF NE NO				
	MOV	4(R5),$CPLUN	;LUN NUMBER IS IN DIFFERENT PLACE
	MOV	30(R5),R4	;SO IS THE SECOND LUN WORD
	BR	71$		;COMMON CODE
70$:	MOV	16(R5),R4	;GET ADDRESS OF SECOND LUN WORD		
71$:	MOV	20(R5),OLDUCB	;RESTORE OLD UCB ADDRESS		
	MOV	24(R5),IMPFLG	;GET SAVED FLAG WORD			
;									
; CHECK STATUS RETURNED
;  - IF SUCCESS, LOOK FOR DEVICE NAME AS A GENERIC DEVICE TYPE
;  - IF FAILURE AND DEVICE NAME IS HT, DO AN ASSIGN CHANNEL DIRECTIVE	
;  - IF FAILURE AND DEVICE NAME IS NON ZERO, LOOK FOR LOCAL DEVICES OF THAT NAME
;  - IF DEVICE NAME IS ZERO, RETURN WITH ERROR STATUS
;
	MOV	4(R5),R2	;GET RETURNED DEVICE NAME		
	MOV	6(R5),R0	; AND UNIT NUMBER
	CMPB	#AC$DIC,(R5)	;IS THIS ACHN?
	BNE	75$		;IF NE NO
	MOV	6(R5),R2	;DEVICE NAME AND UNIT NUMBER ARE 
	MOV	10(R5),R0	; IN DIFFERENT PLACES
75$:
	TST	R2		;WAS DEVICE NAME RETURNED?
	BEQ	130$		;IF EQ ERROR
	CMP	#IS.SUC,MAP6+H$STAT ;WAS SUCCESS RETURNED?
	BEQ	100$		;IF EQ YES				
;									
; CHECK FOR HTn:							
;									
	CMP	#"HT,R2		;IS DEVICE A TERMINAL?			
	BNE	150$		;IF NE NO, LOOK IN LOCAL DEVICE TABLES	
									
	CALL	GETUCB		;GET UCB ADDRESS			
	BCC	90$		;IF CC, OKAY				
80$:	JMP	189$		;IF NOT THERE, ERROR			
90$:									
	BIT	#U2.LOG,U.CW2(R1) ;IS TERMINAL LOGGED IN?		
	BNE	80$		;IF NE, NO - REJECT			
	JMP	370$		;SEND ASSIGN CHANNEL PACKET		
;									
; HOST SUCCESSFULLY ASSIGNED LUN					
;									
100$:	CMPB	#AC$DIC,(R5)	;IS THIS ASSIGN CHANNEL?		
	BNE	110$		;IF NE NO				
									
	MOV	26(R5),R1	;USE UCB ADDRESS FIGURED OUT BEFORE	
	MOV	22(R5),KISAR6	;RESTORE MAPPING TO TASK HEADER		
	BR	120$		;JOIN COMMON CODE			
110$:									
	MOV	22(R5),KISAR6	;RESTORE MAPPING TO TASK HEADER		
	MOV	#377,R0		;LOOK FOR UNIT 377			
	CALL	GETUCB		;LOOK FOR GENERIC UCB			
	BCS	80$		;IF CS, DEVICE NOT THERE
120$:									
;									
; PREPARE TO JOIN COMMON CODE
;
	MOV	OLDUCB,-(SP)	;PUT OLD ASSIGNMENT UCB ADDRESS ON STACK
	JMP	230$		;JOIN COMON CODE

130$:
	.IF DF C$$RTK		;REMOTE TASK SUPPORT
	CALL	RMTERR		;DEALLOCATE PACKET IF REMOTE TASK
	.ENDC

	DRSTS	D.RS5		;RETURN ERROR IE.ULN
150$:
;
; GET INFO SET UP FOR COMMON CODE
;
	MOV	22(R5),KISAR6	;MAP TASK HEADER		
	MOV	R4,R1		;PTR INTO TASK HEADER		
	MOV	$TKTCB,R5	;CURRENT TASK'S TCB ADDRESS
;
; GET OLD ASSIGNMENT UCB ADDRESS FROM HEADER
;
	MOV	OLDUCB,-(SP)	;SAVE UCB ADDRESS

	BR	180$		;JOIN COMMON CODE

160$:
	.ENDC		;C$$RTK

	TST	IMPFLG		;IMPLICIT ALUN?
	BEQ	170$		;IF EQ NO
;
; GET DEVICE AND UNIT NUMBER FROM HEADER EXTENSION
;
	MOV	R1,R4		;GET ADDRESS OF 2ND LUN WORD
	SUB	#H.LUN+2+MAP6,R1 ;GET OFFSET INTO LUT EXTENSION
	ADD	MAP6+H.LUTE,R1	;ADD EXTENSION OFFSET
	MOV	(R1)+,R2	;GET DEVICE NAME
	MOV	(R1),R0		;GET UNIT NUMBER
;
; SET UP OLD UCB ADDRESS
;
	CLR	-(SP)		;NO PREVIOUS UCB ADDRESS
;
; SPECIAL CASE OV - IF OV IS IN LUN EXTENSION, DON'T DO LOGICAL NAME
;  TRANSLATION
;
	CMP	#"OV,R2		;IS THIS OV?
	BNE	180$		;IF EQ NO

	MOV	$TKTCB,R5	;GET TASK'S TCB
	MOV	T.LDV(R5),R1	;GET LOAD DEVICE TCB

	JMP	240$		;JOIN COMMON CODE
170$:
	.ENDC 		;C$$RTB

	MOV	R0,-(SP)	;SAVE ADDRESS OF UCB
	MOV	R1,R4		;SAVE ADDRESS OF SECOND LUN WORD
	MOV	(R3)+,R2	;GET NAME OF DEVICE
	MOVB	(R3),R0		;GET UNIT NUMBER


180$:
	.IF DF C$$RTK		;REMOTE TASK SUPPORT

	BIT	#F5.RTK,$FMSK5	;REMOTE TASKS?
	BNE	220$		;IF NE YES

	.ENDC	;C$$RTK

	.IF DF	M$$MUP

	BIT	#T3.SLV,T.ST3(R5) ;SLAVE TASK?
	BNE	220$		;IF NE YES, BYPASS LOGICAL DEVICE TABLE

	.ENDC



	.IF DF	L$$GCL

	MOV	T.UCB(R5),R1	;GET THE CURRENT TASK'S TI:
	CALL	$GTUSR		;RESOLVE RAW UCB AND SET USER HASH TABLE
	MOV	#$LNTDR,-(SP)	;RESOLVE ANY LOGICAL NAME TRANSLATIONS
	CALL	$MPDC3		;USE ROUTINE IN FOURTH DIRECTIVE COMMON
	BCC	220$		;IF CC, SUCCESSFULLY MATCHED LOGICAL
	TST	R3		;SEE IF ERROR OCCURRED OR NO MATCH AT ALL
	BEQ	190$		;IF EQ VALID MATCH

	.IFF

	BR	190$		;DO OLD LOGICALS

	.IFTF
188$:	
	TST	(SP)+		;CLEAN STACK
189$:
	.IF DF C$$RTK		;REMOTE TASK SUPPORT
	CALL	RMTERR		;DEALLOCATE PACKET IF REMOTE TASK
	.ENDC

	DRSTS	D.RS92		;RETURN WITH ERROR

190$:

	MOV	#$LOGHD,R3	;POINT TO LOGICAL ASSIGNMENT LIST
200$:	MOV	(R3),R3		;GET ADDRESS OF NEXT ENTRY
	BEQ	220$		;IF EQ END OF LIST
	TSTB	L.TYPE(R3)	;SYSTEM WIDE ASSIGNMENT?
	BEQ	210$		;IF EQ YES
	CMP	L.UCB(R3),T.UCB(R5) ;TI UCB ADDRESS MATCH?
	BNE	200$		;IF NE NO
210$:	CMP	R2,L.NAM(R3)	;DEVICE NAME MATCH?
	BNE	200$		;IF NE NO
	CMPB	R0,L.UNIT(R3)	;UNIT NUMBER MATCH?
	BNE	200$		;IF NE NO
	MOV	L.ASG(R3),R1	;GET ASSIGNMENT UCB ADDRESS
	BR	230$		;FINISH IN COMMON CODE

	.ENDC	;L$$GCL

220$:									
	CALL	GETUCB		;GET CORRECT UCB ADDRESS		
	BCS	188$		;IF CS ERROR				
									
	.IF DF C$$RTK		;REMOTE TASK SUPPORT			

	BIT	#F5.RTK,$FMSK5	;REMOTE TASKS?
	BEQ	230$		;IF EQ NO				
;									
; TEST FOR GENERIC DEVICE
;
	CMP	(R1),$XXLOW	;IS THIS A GENERIC DEVICE? HIGHER THAN LOW DCB?
	BLO	230$		;IF LO NO				
	CMP	(R1),$XXHGH	;LOWER THAN HIGH DCB?			
	BLOS	188$		;IF LOS, IT IS GENERIC			
									
	.ENDC	;C$$RTK							
230$:				;REFERENCE LABEL			
									
									
	.IF DF	V$$TRM

	MOV	(R1),R3		;POINT TO DEVICE DCB
	CMP	D.NAM(R3),#"VT	;IS THE DEVICE A VIRTUAL TERMINAL?
	BNE	240$		;IF NE NO
	CMP	U.PTCB(R1),R5	;IS ISSUING TASK THE PARENT?
	BEQ	240$		;IF EQ NO
	CMP	R1,T.UCB(R5)	;IS ISSUING TASK AN OFFSPRING?
	BNE	188$		;IF NE NO

	.ENDC


240$:	MOV	(SP)+,R3	;WAS LUN PREVIOUSLY ASSIGNED?
	BEQ	260$		;IF EQ NO
	CMP	R5,U.ATT(R3)	;UNIT ATTACHED TO CURRENT TASK?
	BNE	250$		;IF NE NO
	MOV	R1,-(SP)	;SAVE NEW ASSIGNMENT UCB ADDRESS
	MOV	R1,R0		;COPY UCB ADDRESS
	CALL	$MPLND		;MAP TO REAL UCB ADDRESS
	MOV	(SP)+,R1	;RETRIEVE NEW ASSIGNMENT UCB ADDRESS
	CMP	R0,R3		;NEW ASSIGNMENT TO SAME FINAL UCB?
	BNE	320$		;IF NE NO
250$:	MOV	R3,R5		;COPY OLD ASSIGNMENT UCB ADDRESS
	MOV	#$IOKIL,-(SP)	;SET TO KILL I/O ON PREVIOUS ASSIGNMENT
	BR	261$
260$:
	MOV	#NULL,-(SP)	; PUT ADDRESS ON STACK TO KEEP IT A KNOWN
				;    LENGTH.  THIS SHOULD BE THE ADDRESS OF
				;    ANY "RTS PC" INSTRUCTION.
261$:
	MOV	R1,-2(R4)	;ASSIGN LUN TO NEW UNIT

	.IF DF 	C$$RTK		;REMOTE TASKS
;									
; DECIDE IF WE REALLY WANT TO DEALLOCATE THE CPRBUF PACKET		
;									
	BIT	#F5.RTK,$FMSK5	;REMOTE TASKS?
	BEQ	300$		;IF EQ NO

;
; WE HAVE SUCCESSFULLY ASSIGNED A LOCAL DEVICE.  NOW WE NOTIFY THE
; VMS SYSTEM THAT IT CAN DEASSIGN WHATEVER PREVIOUS ASSIGNMENT THERE
; WAS FOR THIS LUN.
;
	MOV	(R1),R0		; GET DCB.
	CMP	#"TI,D.NAM(R0)	; IS THIS TI:?
	BEQ	266$		; YES, LEAVE IT ALONE; VMS HAS IT ALREADY.
	MOV	KISAR6,-(SP)	; SAVE CURRENT MAPPING.
	MOV	$CPPKT,KISAR6	; MAP PACKET.
	TST	MAP6+H$STAT	; DID VMS SUCCESSFULLY ASSIGN A DEVICE?
	BGT	265$		; YES, LEAVE IT THERE.
				; OTHERWISE, WE'RE GOING TO DEASSIGN THE
				;    PREVIOUS DEVICE.
	MOVB	#HT$DEA,MAP6+H$TYPE
				; INDICATE DEASSIGN PACKET.
	MOV	#MAP6+P$LUN,R0	; GET ADDRESS OF PARAMETERS.
	MOV	$CPLUN,(R0)+	; PASS LUN TO DEALLOCATE.
	MOV	R1,(R0)+	; SAVE REGISTER.
	MOV	R2,(R0)+	; SAVE REGISTER.
	MOV	R3,(R0)+	; SAVE REGISTER.
	MOV	R4,(R0)+	; SAVE REGISTER.
	MOV	R5,(R0)+	; SAVE REGISTER.
	MOV	IMPFLG,(R0)+	; SAVE IMPLICIT DIRECTIVE FLAG.
	MOV	(SP)+,(R0)+	; SAVE SAVED APR 6.
	MOV	(SP)+,(R0)+	; SAVE RETURN ADDRESS.
	SUB	#MAP6,R0	; COMPUTE LENGTH OF PACKET WITH SAVE AREA.

	CLR	$CPPKT		; MAKE SURE NO ONE ELSE USES OUR PACKET.
	CPSEN$	#SF$BIA!SF$HDR!SF$AST!SF$BLK,KISAR6,R0
				; SEND PACKET.
	MOV	R0,KISAR6	; MAP PACKET.
	MOV	R0,$CPPKT	; RESTORE RECORD OF PACKET'S ADDRESS.
	MOV	#MAP6+P$LUN+2,R0
				; POINT TO SAVE AREA.
	MOV	(R0)+,R1	; RESTORE REGISTER.
	MOV	(R0)+,R2	; RESTORE REGISTER.
	MOV	(R0)+,R3	; RESTORE REGISTER.
	MOV	(R0)+,R4	; RESTORE REGISTER.
	MOV	(R0)+,R5	; RESTORE REGISTER.
	MOV	(R0)+,IMPFLG	; RESTORE IMPLICIT DIRECTIVE FLAG.
	MOV	2(R0),-(SP)	; RESTORE RETURN ADDRESS.
	MOV	(R0),-(SP)	; RESTORE MAPPING TO STACK.
265$:
	MOV	(SP)+,KISAR6	; RESTORE PREVIOUS MAPPING.
266$:
	CMP	#$IOKIL,(SP)	;HAS I/O KILL BEEN REQUESTED?
	BNE	280$		;IF NE NO - DEALLOCATE PACKET
;									
; CHECK IF THE NEW ASSIGNED DEVICE IS A GENERIC ONE			
;									
	CMP	(R1),$XXLOW	;IS NEW DEVICE GENERIC?			
	BLO	270$		;IF LO NO				
	CMP	(R1),$XXHGH	;IS NEW DEVICE GENERIC?			
	BLOS	280$		;IF LOS - YES, DEALLOCATE PACKET	
;									
; NEW DEVICE IS LOCAL,							
; CHECK IF THE OLD ASSIGNED DEVICE IS A GENERIC ONE			
;									
270$:									
	CMP	(R5),$XXLOW	;IS THIS A GENERIC DEVICE?		
	BLO	280$		;IF LO NO - DEALLOCATE PACKET		
	CMP	(R5),$XXHGH	;IS THIS A GENERIC DEVICE?		
	BLOS	290$		;IF LOS YES - DON'T DEALLOCATE PACKET	
280$:									
	MOV	$CPPKT,R0	;GET ADDRESS OF PACKET
	CALL	$CPDEA		;DEALLOCATE IT NOW
	CLR	$CPPKT		;INDICATE WE ARE DONE WITH PACKET
290$:
;
; IF THIS IS A REMOTE SYSTEM, THE KX DRIVER SET THE ERROR STATUS
;
	MOV	#IS.SUC,-(SP)	;OVERRIDE CPRSYS' ERROR STATUS
	MTPD$	@#H.DSW		;
	BIC	#1,$UMPS	;MAKE SURE CARRY BIT IS CLEAR		
300$:
	.ENDC 	; C$$RTK

	.IF DF	C$$RTB		;RUN TIME BINDING
;
; WE SHOULDN'T NEED A RUN TIME CONDITIONAL HERE, BECAUSE IF RTB IS NOT
; SUPPORTED, IMPFLG WILL NEVER GET SET ANYWAY
;
	TST	IMPFLG		;IMPLICIT ALUN
	BEQ	310$		;IF EQ NO

	SUB 	#2,$UMPC	;BACK UP THE USER'S PC
	MOV	#$STACK-22,SP	;DON'T DO DRFIN

310$:
	.ENDC	; C$$RTB

	RETURN			;

320$:	MOV	R1,-(SP)	;SAVE NEW UCB POINTER

	.IF DF	X$$HDR

	MOV	$SAHPT,R1	;GET TASK HEADER ADDRESS

	.IFF

	MOV	$HEADR,R1	;GET TASK HEADER ADDRESS

	.ENDC

	ADD	#H.NLUN,R1	;POINT TO THE NUMBER OF LUNS
	MOV	(R1),-(SP)	;PICK UP COUNT
330$:	CMP	(R1)+,(R1)+	;ADVANCE TO NEXT UCB POINTER + 2
	CMP	R1,R4		;SAME LUN AS BEING REASSIGNED?
	BEQ	340$		;IF EQ YES
	MOV	-2(R1),R0	;GET THIS LUN ASSIGNMENT
	BEQ	340$		;IF EQ, LUN NOT ASSIGNED

	CALL	$MPLND		;FOLLOW ANY REDIRECT; HANDLE TI:
	CMP	R0,R3		;LUN ASSIGNED TO SAME DEV AS REASS LUN?
	BNE	340$		;NO, BRANCH
	TST	(SP)+		;REMOVE COUNT
	MOV	(SP)+,R1	;GET NEW LUN ASSIGNMENT
	BR	250$		;IF EQ YES, ATTACH CAN BE IGNORED
340$:	DEC	(SP)		;POINT TO NEXT LUN
	BGT	330$		;TRY AGAIN
	CMP	(SP)+,(SP)+	;CLEAN STACK
350$:
	.IF DF C$$RTK		;REMOTE TASK SUPPORT
	TST	(SP)+		;CLEAN STACK
	CALL	RMTERR		;DEALLOCATE PACKET IF REMOTE TASK
	.ENDC			;C$$RTK

360$:	DRSTS	D.RS90		;LUN LOCKED IN USE

	.IF DF C$$RTK		;REMOTE TASK SUPPORT
;									
; SEND ASSIGN CHANNEL PACKET						
;									
; INPUT: R1 - UCB ADDRES OF UNIT TO ASSIGN LUN TO 			
;	 R5 - POINTER TO DPB IN PACKET					
;									
370$:									
	MOVB	#AC$DIC,(R5)+	;DIC					
	MOVB	#AC$SIZ,(R5)+	;SIZ					
	MOVB	#AC$SUB,(R5)+	;SUBFUNCTION				
	CLRB	(R5)+		;MODIFIER				
	MOVB	$CPLUN,(R5)+	;LUN NUMBER				
	CLRB	(R5)+		;TBMASK					
	MOV	#H$SIZE+32,(R5)+ ;POINTER TO BUFFER			
	CLR	(R5)+		;MAKE IT A LONG WORD			
	MOV	#VNAMSZ,(R5)+	;SIZE OF BUFFER	
	MOV	#"HT,(R5)+	;RSX DEVICE NAME
	MOV	(R5),12(R5)	;MOVE THE POINTER TO THE SECOND LUN WORD
	CLRB	(R5)+		;MOVE UP ONE BYTE
	MOVB	U.UNIT(R1),(R5)+ ;STORE THE DEVICE UNIT
	ADD	#6,R5		;POINT TO UCB ADDRESS FIELD 		
	MOV	R1,(R5)+	;STORE UCB ADDRESS
	TST	(R5)+		;SKIP PAST POINTER TO SECOND LUN WORD
	CMPB	U.CPUN(R1),140000+H$UNIT ;IS THIS TI:?
	BNE	371$		;NOPE, USE VMS TERMINAL NAME
	MOV	#3,-20(R5)	;CHANGE SIZE TO SIZE OF TI:
	CLR	-16(R5)		;CLEAR OUT HT NAME
	CLR	-14(R5)		;AND UNIT
	MOV	#"TI,(R5)+	;MOVE TI: INTO STRING
	MOVB	#':,(R5)+
	BR	373$		;SEND IT OFF
371$:
	ADD	#U.VNAM,R1	;POINT TO VMS TERMINAL NAME
	MOV	(R1)+,(R5)+	;COPY TERMINAL NAME
	BNE	372$		;IF THERE, CONTINUE
	JMP	189$		;EXIT WITH ERROR
372$:	MOV	(R1)+,(R5)+	;ALL FOUR WORDS
	MOV	(R1)+,(R5)+	;...
	MOV	(R1)+,(R5)+	;...
373$:
	MOV	#SN$IMP,R2	;SEND PACKET IMPLICITLY			
	MOV	#H$SIZE+42,R1	;GET SIZE OF PACKET
	JMP	60$		;SEND THE PACKET			

;
; RMTERR - REMOTE ERROR CODE
;
;    - CHECK IF REMOTE TASKS ARE SUPPORTED
;    - IF PACKET ALLOCATED, DEALLOCATE IT
;    - IF IMPLICIT ALUN, ERROR CODE ALREADY SET, DON'T RETURN TO CALLER
;
RMTERR:
	BIT	#F5.RTK,$FMSK5	;REMOTE TASKS SUPPORTED?
	BEQ	20$		;IF EQ NO

	MOV	$CPPKT,R0	;GET PACKET BIAS
	BEQ	10$		;IF NONE, DON'T DEALLOCATE IT

	CALL	$CPDEA		;DEALLOCATE PACKET
	CLR	$CPPKT		;INDICATE PACKET DEALLOCATED
10$:
	TST	IMPFLG		;WAS THIS AN IMPLICIT ALUN?
	BNE	20$		;IF EQ NO
	TST	(SP)+		;DON'T RETURN TO CALLER, KXDRV HAS SET STATUS
20$:	
	RETURN			;

	.ENDC	;C$$RTK
;									
; GETUCB - ROUTINE TO FIND CORRECT UCB IN SYSTEM TABLES			
;									
; INPUT: R2 - DEVICE NAME						
;	 R0 - UNIT NUMBER						
;									
; OUTPUT: R1 - UCB ADDRESS						
;	  R3 - DCB ADDRESS						
;									
GETUCB:									
	MOV	#$DEVHD,R3	;POINT TO PHYSICAL DEVICE TABLES	
10$:	MOV	(R3),R3		;GET ADDRESS OF NEXT DCB		
	BEQ	20$		;IF EQ END OF TABLES			
	CMP	R2,D.NAM(R3)	;DEVICE NAME MATCH?			
	BNE	10$		;IF NE NO				
							
	CMPB	R0,D.UNIT(R3)	;UNIT GREATER THAN OR EQUAL TO LOW BOUNDRY?
	BLO	10$		;IF LO NO				
	CMPB	R0,D.UNIT+1(R3)	;UNIT LESS THAN OR EQUAL TO HIGH BOUNDRY?
	BHI	10$		;IF HI NO				
	SUB	D.UNIT(R3),R0	;CALCULATE RELATIVE UNIT NUMBER		
	BIC	#177400,R0	;CLEAR EXCESS BITS			
	MOV	D.UCBL(R3),R1	;GET LENGTH OF UCB IN BYTES	
	CALL	$MUL		;CALCULATE NUMBER OF BYTES	
	ADD	D.UCB(R3),R1	;CALCULATE ADDRESS OF UCB	
								
	RETURN			;RETURN SUCCESS			
20$:								
	SEC							
NULL:				; THIS RETURN DOUBLES AS A RETURN FOR THE
				;    PRECEDING CODE AND A LABEL FOR A NULL
				;    ROUTINE.
	RETURN			;RETURN FAILURE			

	.END